Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Pascal/Applications/CornerClock 1.5/CornerClock.p

Text File | 1996-02-29 | 13.8 KB | 631 lines | [TEXT/CWIE]

{
CornerClock is a pascal program based upon Masafumi Ueda's MBarClock program.

MBarClock was a program which displayed the time or date in the menu bar to the left
of the Apple menu.  CornerClock uses that same feature and adds sound.

I converted Masafumi's MBarClock from C to Pascal, and then began forging it into
a chime replacement program.  Currently, if you have long chimes activated with your
clock which comes with system 7.5, you may experience a very annoying distorted
sound which interrupts your chime.  This is a known bug with the system, as it does not
appear to lock the sound handle when it plays it (it should lock it because it plays it
asynchronously).  CornerClock plays the hourly chime asynchronously, but locks the
handle so you get a smooth play.

CornerClock will play a grandfather clock chime on the hour (3 chimes as 3:00, 4 at 4:00, etc.).

When you place the cursor over the time, it will change to the date for 2 seconds, then change back
to the time (same feature in MBarClock except now there is sound).  I've also added some menus
to CornerClock so that you can toggle the date and time, and force a chime.

There are many enhancements which can be made, like changing the chime sound, changing the
volume, etc., but I'm releasing it as is to provide the Pascal community with some more sample
Pascal code.  Feel free to send me any questions or notes of thanks.

2/4/96:  v1.1 - Fixed bug so that 12:00 noon displays as 12:00 instead of 0:00.
2/10/96: v1.2 - Added a toggle under the File menu for disabling the chime.
2/29/96: v1.5 - Added a File menu item for choosing the default display (date or time).
              - Chime and default display selections are now saved in a Preference file.
              - Application now handles an AEQuit so that it properly exits when asked
                to quit from another app.

CornerClock ©Bill Catambay, 1996,  [e-mail]
All rights reserved worldwide.
}
Program CornerClock;

Uses
    Toolbox, Sound, Resources, Icons;

Const
    kAbout = 0;
    kDisplayDate = 1;
    kDisplayTime = 2;
    kChime = 3;
    iDate = 1;
    iTime = 2;
    iForce = 3;
    iChime = 5;
    iDefault = 6;
    iQuit = 8;
    mApple = 128;
    mFile = 129;
    mEdit = 130;
    mDefault = 131;

Type
    PrefsRec    =    record
        chimeOn:    boolean;
        default:    integer;
        end;
    PrefsPtr    =    ^PrefsRec;
    PrefsHandle =    ^PrefsPtr;

Var
    AppleMenu, FileMenu, EditMenu, DefaultMenu: MenuHandle;
    ClockPort: CGrafPtr;
    NUMs: array[0..10] of CIconHandle;
    running: Boolean;
    ClockRect: array[0..3] of Rect;
    Corner: Rect;
    default: integer;
    bkGnd: RgnHandle;
    dispStat: integer;
    chimes: integer;
    chimeStart: longint;
    chimeOn: boolean;
    timerStart: longint;
    gBackground: boolean;
    sounds: array[0..3] of SndListHandle;
    sndChans: array[0..3] of SndChannelPtr;
    backupChan: SndChannelPtr;
    forceChime: boolean;
    fRefnum,vRefnum: integer;
    gOSErr: OSErr;

Procedure Die;

Var
    startCount:    longint;

    begin
    SysBeep(30);
    SysBeep(30);
    SysBeep(30);
    startCount := TickCount;
    repeat
    until TickCount - startCount > 30;
    ExitToShell;
    end;

Procedure CheckMachine;

Var
    sysEnv: SysEnvRec;
    i: integer;

    begin
    i := SysEnvirons(curSysEnvVers, sysEnv);
    if i <> noErr then
        Die;
    if not sysEnv.hasColorQD then
        Die;
    if sysEnv.systemVersion < $700 then
        Die;
    end;

Procedure OpenClockPort;

    begin
    ClockPort := CGrafPtr(NewPtrClear(sizeof(CGrafPort)));
    if ClockPort = NIL then
        Die;
    OpenCPort(ClockPort);
    end;

Procedure SetupMenu;

    begin
    ClearMenuBar;
    AppleMenu := GetMenu(mApple);
    InsertMenu(AppleMenu,0);
    AppendResMenu(AppleMenu,'DRVR');
    FileMenu := GetMenu(mFile);
    InsertMenu(FileMenu,0);
    EditMenu := GetMenu(mEdit);
    InsertMenu(EditMenu,0);
    DefaultMenu := GetMenu(mDefault);
    InsertMenu(DefaultMenu,-1);
    DrawMenuBar;
    end;

Procedure LoadIcons;

Var
    i: integer;

    begin
    for i := 0 to 10 do
        NUMs[i] := GetCIcon(2000 + i);
    end;

Procedure SetupRects;

Var
    rgn: RgnHandle;
    r: Rect;

    begin
    SetRect(ClockRect[0], 2,2,10,10);
    SetRect(ClockRect[1], 8,2,16,10);
    SetRect(ClockRect[2], 2,10,10,18);
    SetRect(ClockRect[3], 8,10,16,18);
    bkGnd := NewRgn;
    SetRect(corner,0,0,16,19);
    RectRgn(bkGnd,corner);
    UnionRect(ClockRect[0], ClockRect[3], r);
    r.bottom := r.bottom - 1;
    r.right := r.right - 2;
    rgn := NewRgn;
    RectRgn(rgn, r);
    DiffRgn(bkGnd, rgn, bkGnd);
    DisposeRgn(rgn);
    end;

Function LoadPrefs: OSerr;

Var
    myPrefs:    PrefsHandle;

    begin
    myPrefs := PrefsHandle(GetResource('pref',128));
    if myPrefs = NIL then
        begin
        chimeOn := true;
        default := kDisplayTime;
        LoadPrefs := ResError;
        end
    else
        begin
        chimeOn := myPrefs^^.chimeOn;
        default := myPrefs^^.default;
        ReleaseResource(handle(myPrefs));
        LoadPrefs := noErr;
        end;
    end; { of LoadPrefs }

Function SavePrefs: OSErr;

Var
    myPrefs:    PrefsHandle;

    Procedure Check(result: OSErr; isResource: boolean);

        begin
        if result <> noErr then
            begin
            if myPrefs <> nil then
                if isResource then
                    ReleaseResource(Handle(myPrefs))
                else
                    DisposeHandle(Handle(myPrefs));
            SavePrefs := result;
            exit(SavePrefs);
            end;
        end;

    begin
    myPrefs := PrefsHandle(GetResource('pref', 128));
    if myPrefs = NIL then
        begin
        myPrefs := PrefsHandle(NewHandle(sizeof(PrefsRec)));
        Check(MemError, false);
        AddResource(handle(myPrefs), 'pref', 128, 'Defaults');
        Check(ResError, false);
        end;
    myPrefs^^.chimeOn := chimeOn;
    myPrefs^^.default := default;
    ChangedResource(Handle(myPrefs));
    Check(ResError, true);
    UpdateResFile(CurResFile);
    Check(ResError, true);
    ReleaseResource(Handle(myPrefs));
    SavePrefs := noErr;
    end; { of SavePrefs }

Function OpenPrefs(var fRefnum: integer; var vRefnum: integer; prefName: Str255): OSerr;

Var
    err:        OSerr;
    DirID:        longint;
    fileSpec:    FSSpec;

    begin
    Err := FindFolder(kOnSystemDisk, kPreferencesFolderType,
        kCreateFolder, vRefNum, DirID);
    if Err <> noErr then
        begin
        openPrefs := err;
        exit(openPrefs);
        end;
    Err := FSMakeFSSpec(vRefNum, DirID, prefName, fileSpec);
    if (err <> Noerr) and (err <> fnfErr) then
        begin
        openPrefs := err;
        exit(openPrefs);
        end;
    if Err = fnfErr then { not there so create it }
        begin
        Err := FSpCreate (fileSpec, 'CCLK', 'pref', 0);
        if err <> Noerr then
            begin
            openPrefs := err;
            exit(openPrefs);
            end;
        end;
    fRefnum := FSpOpenResFile(fileSpec, fsCurPerm);
    if fRefnum < 0 then
        begin
        FSpCreateResFile(fileSpec, 'CCLK', 'pref', smSystemScript);
        err := ResError;
        if err <> Noerr then
            begin
            openPrefs := err;
            exit(openPrefs);
            end;
        fRefnum := FSpOpenResFile(fileSpec, fsCurPerm);
        end;
    err := ResError;
    if err <> Noerr then
        begin
        openPrefs := err;
        exit(openPrefs);
        end;
    openPrefs := LoadPrefs;
    end;

Function GotRequiredParams (var theAppleEvent: AppleEvent): OSErr;

Var
    myErr: OSErr;
    returnedType: DescType;
    actualSize: Size;

    Begin
    myErr := AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr, typeWildCard, returnedType,
        Nil, 0, actualSize);
    If myErr = errAEDescNotFound Then
        GotRequiredParams := noErr
    Else If myErr = noErr Then
        GotRequiredParams := errAEParamMissed;
    End;    { of GotRequiredParams }

Function HandleQuitEvent(var theAppleEvent: AppleEvent; var reply: AppleEvent;
                           handlerRefcon: LongInt): OSErr;

    Begin
    gOSErr := GotRequiredParams(theAppleEvent);
    If gOSErr = noErr Then
        running := false;
    if (reply.dataHandle = NIL) | (handlerRefcon = 0) then  ; { read variable to eliminate compiler warning }
    HandleQuitEvent := gOSErr;
    End;    { of MyHandleQuiteEvent }

Procedure AdjustMenu;

Var
    err:    OSErr;

    begin
    if chimeOn then
        begin
        chimes := 0;
        chimeStart := 0;
        forceChime := False;
        EnableItem(FileMenu, iForce);
        end
    else
        begin
        err := SndDisposeChannel(backupChan, True);
        backupChan := NIL;
        DisableItem(FileMenu, iForce);
        end;
    CheckItem(FileMenu, iChime, chimeOn);
    if default = kDisplayTime then
        CheckItem(DefaultMenu, kDisplayDate, False)
    else
        CheckItem(DefaultMenu, kDisplayTime, False);
    CheckItem(DefaultMenu, default, True);
    end; { AdjustMenu }

Procedure InitAppl;

Var
    i: integer;
    err: OSErr;

    begin
    CheckMachine;
    OpenClockPort;
    SetupMenu;
    LoadIcons;
    SetupRects;
    running := true;
    chimes := 0;
    chimeStart := 0;
    forceChime := False;
    gBackground := false;
    for i := kAbout to kChime do
        begin
        sounds[i] := SndListHandle(GetResource(soundListRsrc,128 + i));
        HLockHi(Handle(sounds[i]));
        sndChans[i] := NIL;
        end;
    backupChan := NIL;
    err := OpenPrefs(fRefnum,vRefnum,'CornerClock Preferences');
    if err <> noErr then
        Die;
    dispStat := default;
    AdjustMenu;
    gOSErr := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication,
        @HandleQuitEvent, 0, false);
    end;

Procedure DoSound(sndID: integer);

Var
    err: OSErr;
    sndCmd: SndCommand;
    sndHead: SoundHeaderPtr;
    SndChanStat: SCStatus;

    begin
    if sounds[sndID] = NIL then
        begin
        sysBeep(1);
        exit(DoSound);
        end;
    if (sndChans[sndID] <> NIL) and (backupChan <> NIL) then
        begin
        err := SndDisposeChannel(backupChan, True);
        backupChan := NIL;
        end;
    if sndChans[sndID] <> NIL then
        begin
        backupChan := sndChans[sndID];
        sndChans[sndID] := NIL;
        end;
    err := SndNewChannel(sndChans[sndID], sampledSynth, 0, NIL);
    if (err <> noErr) or (sndChans[sndID] = NIL) then
        begin
        sysBeep(1);
        exit(DoSound);
        end;
    sndHead := SoundHeaderPtr(longint(sounds[sndID]^) + 20);
    sndCmd.cmd := bufferCmd;
    sndCmd.param1 := 0;
    sndCmd.param2 := ORD4(sndHead);
    err := SndDoCommand(sndChans[sndID], sndCmd, false);
    err := SndChannelStatus(sndChans[sndID], sizeof(SndChanStat), @SndChanStat);
    if err <> noErr then
        begin
        sysBeep(1);
        err := SndDisposeChannel(sndChans[sndID], True);
        sndChans[sndID] := NIL;
        exit(DoSound);
        end;
{
    chimeStart := TickCount;
    While SndChanStat.scChannelBusy and (not Button) and (Err = NoErr) and (SndArray[1] <> NIL) do
        Err := SndChannelStatus(SndArray[1], sizeof(SndChanStat), @SndChanStat);}
    end;

Procedure DoAbout;

Var
    p: GrafPtr;
    d: DialogPtr;

    begin
    GetPort(p);
    d := GetNewDialog(128, NIL, WindowPtr(-1));
    DrawDialog(d);
    DoSound(kAbout);
    repeat until Button;
    DisposeDialog(d);
    SetPort(p);
    FlushEvents(mDownMask, 0);
    end;

Procedure SwitchView;

    begin
    if dispStat = kDisplayDate then
        dispStat := kDisplayTime
    else
        dispStat := kDisplayDate;
    doSound(dispStat);
    if dispStat <> default then
        timerStart := TickCount;
    end;

Procedure ForceView(newView: integer);

    begin
    dispStat := newView;
    doSound(dispStat);
    if dispStat <> default then
        timerStart := TickCount;
    end;

Procedure DoMenu(SelMenu: longint);

Var
    item,i: integer;
    s:         Str255;

    begin
    item := LoWord(SelMenu);
    case HiWord(SelMenu) of
        mApple:    if item = 1 then
                    DoAbout
                else
                    begin
                    GetMenuItemText(AppleMenu, item, s);
                    i := OpenDeskAcc(s);
                    end;
        mFile:    case item of
                iDate:    ForceView(kDisplayDate);
                iTime:    ForceView(kDisplayTime);
                iForce:    if chimeOn then
                            forceChime := True;
                iChime:    begin
                        chimeOn := not chimeOn;
                        AdjustMenu;
                        end;
                iQuit:    running := false;
                {CASE}    end;
        mDefault:
                if default <> item then
                    begin
                    default := item;
                    AdjustMenu;
                    end;
    {CASE}        end;
    HiliteMenu(0);
    end;

Procedure UpdateWindow(wp: WindowPtr);

    begin
    SetPort(wp);
    BeginUpdate(wp);
    EndUpdate(wp);
    end;

Procedure DrawDigit(upper,lower: integer; upShow10, loShow10: boolean);

Var
    p: GrafPtr;

    begin
    GetPort(p);
    SetPort(GrafPtr(ClockPort));
    ForeColor(blackColor);
    PaintRgn(bkGnd);
    if (upper >= 10) | upShow10 then
        PlotCIcon(ClockRect[0], NUMs[ (upper div 10) mod 10])
    else
        PlotCIcon(ClockRect[0], NUMs[10]);
    PlotCIcon(ClockRect[1], NUMs[upper mod 10]);
    if (lower >= 10) | loShow10 then
        PlotCIcon(ClockRect[2], NUMs[(lower div 10) mod 10])
    else
        PlotCIcon(ClockRect[2], NUMs[10]);
    PlotCIcon(ClockRect[3], NUMs[lower mod 10]);
    SetPort(p);
    end;

Procedure DrawClock;

Const
    chimeMinute = 0;

Var
    dt: DateTimeRec;
    p: GrafPtr;
    pt: point;

    begin
    GetPort(p);
    SetPort(GrafPtr(ClockPort));
    GetTime(dt);
    GetMouse(pt);
    if PtInRect(pt, corner) and (dispStat = default) then
        SwitchView;
    if (dispStat <> default) & (timerStart + 300 < TickCount) then
        SwitchView;
    ForeColor(blackColor);
    PaintRgn(bkGnd);
    case dispStat of
        kDisplayDate:    DrawDigit(dt.month, dt.day, false, false);
        kDisplayTime:    if dt.hour = 12 then
                            DrawDigit(dt.hour, dt.minute, false, true)
                        else
                            DrawDigit(dt.hour mod 12, dt.minute, false, true);
    {CASE}                end;
    if chimeOn then
        begin
        if ((dt.minute = chimeMinute) or forceChime) and (chimes = 0) then
            chimes := dt.hour mod 12;
        if (chimes > 0) & ((chimeStart = 0) | (chimeStart + 120 < TickCount)) then
            begin
            doSound(kChime);
            chimeStart := TickCount;
            dec(chimes);
            if chimes = 0 then
                dec(chimes);
            end
        else if (chimes = -1) & (dt.minute <> chimeMinute) then
            begin
            chimes := 0;
            forceChime := False;
            chimeStart := 0;
            end;
        end;
    SetPort(p);
    end;

Procedure MainLoop;

Var
    event: EventRecord;
    dw: WindowPtr;
    ascii: char;
    sleep: longint;
    i: integer;
    err: OSErr;

    begin
    repeat
        DrawClock;
        if chimes > 0 then
            sleep := 1
        else
            sleep := 20;
        if WaitNextEvent(everyEvent, event, sleep, NIL) then
            case event.what of
                mouseDown:    case FindWindow(event.where, dw) of
                                inMenuBar:    DoMenu(MenuSelect(event.where));
                            {CASE}            end;
                keyDown:    begin
                            ascii := chr(BAnd(event.message,charCodeMask));
                            if BAnd(event.modifiers,cmdKey) > 0 then
                                DoMenu(MenuKey(ascii));
                            end;
                updateEvt:    UpdateWindow(WindowPtr(event.message));
                osEvt:        if BAnd(brotl(event.message,8),$FF) = suspendResumeMessage then
                                gBackground := BAnd(event.message,resumeFlag) = 0;
                kHighLevelEvent:
                            gOSErr := AEProcessAppleEvent(Event);
            {CASE}            end;
    until not running;
    if SavePrefs <> noErr then
        sysBeep(30);
    DisposeRgn(bkGnd);
    for i := 0 to 2 do
        begin
        HUnLock(Handle(sounds[i]));
        DisposeHandle(Handle(sounds[i]));
        err := SndDisposeChannel(sndChans[i], True);
        end;
    if backupChan <> NIL then
        err := SndDisposeChannel(backupChan, True);
    end;

begin
InitToolbox;
FlushEvents(everyEvent, 0);
InitAPPL;
MainLoop;
end.